home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d2 / weed.arc / WEED.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-08-19  |  7.5 KB  |  289 lines
  1. PROGRAM Weed;  { V 2.0 }
  2.  
  3. {
  4.   ┌──────────────────────────────────────────────────────┬──────────────────┐
  5.   │  Pinnacle  Software's  File  Cleaner-Upper  Program  │       WEED       │
  6.   ├──────────────────────────────────────────────────────┴──────────────────┤
  7.   │  C O P Y R I G H T  (C)  1989  BY   P I N N A C L E    S O F T W A R E  │
  8.   │  P.O. Box  386, Town of Mount Royal, Montreal, Quebec, Canada  H3P 3C6  │
  9.   ├─────────────────────────────────────────────────────────────────────────┤
  10.   │  Permission is  hereby given to distribute this Pinnacle product, pro-  │
  11.   │  vided that  it is distributed in its  complete  and  unaltered  form,  │
  12.   │  including all  programs, text and data.                                │
  13.   └─────────────────────────────────────────────────────────────────────────┘
  14.  
  15.   PROGRAM PURPOSE:  Keep or delete, from text files, lines with given text.
  16.  
  17. }
  18.  
  19. USES CRT;  { Tested under Turbo Pascal V4.00 }
  20.  
  21. CONST
  22.   MaxDelText = 100;  { Heck, it's only 25K }
  23.  
  24. TYPE
  25.   String80  =  STRING[80];
  26.   InRecord  =  STRING[255];
  27.   OtRecord  =  STRING[255];
  28.  
  29. VAR
  30.   Casing      : CHAR;
  31.   CompData    : InRecord;
  32.   DelCount    : INTEGER;
  33.   DelText     : ARRAY[1..MaxDelText] OF InRecord;
  34.   Finished    : BOOLEAN;
  35.   InChar      : CHAR;
  36.   InData      : InRecord;
  37.   InFileName  : String80;
  38.   InFile      : TEXT;
  39.   Method      : CHAR;
  40.   OutData     : OtRecord;
  41.   OutFile     : TEXT;
  42.   OutFileName : String80;
  43.  
  44. PROCEDURE TextInverseOn;
  45. BEGIN TEXTCOLOR(BLACK); TEXTBACKGROUND(LIGHTGRAY); END;
  46.  
  47. PROCEDURE TextInverseOff;
  48. BEGIN TEXTCOLOR(CYAN); TEXTBACKGROUND(BLACK); END;
  49.  
  50. PROCEDURE Ce(LineIn : String80);
  51. BEGIN GOTOXY(TRUNC((80-LENGTH(LineIn))/2),WHEREY); WRITE(LineIn); END;
  52.  
  53. PROCEDURE CeLn(LineIn : String80);
  54. BEGIN GOTOXY(TRUNC((80-LENGTH(LineIn))/2),WHEREY); WRITELN(LineIn); END;
  55.  
  56. FUNCTION Upper(UStr : String80) : String80;
  57. VAR
  58.   UCntr : INTEGER;
  59. BEGIN
  60.   FOR UCntr := 1 TO LENGTH(UStr) DO UStr[UCntr] := UPCASE(UStr[UCntr]);
  61.   Upper := UStr;
  62. END; { Function Upper }
  63.  
  64. PROCEDURE StartUp;
  65. BEGIN
  66.   Finished := FALSE;
  67. END;
  68.  
  69. PROCEDURE Pinnacle;
  70. BEGIN
  71.   CLRSCR;
  72.   TextInverseOff;
  73.   WRITELN('▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓');
  74.   TextInverseOn;
  75.   WRITELN('╦══╗ ╦ ╦═╗ ╔ ╦═╗ ╔ ╔═╗ ╔══╗ ╦   ╦══╗   ╔══╗ ╔══╗ ╦══╗ ╔═╦═╗ ╗   ╔ ╔═╗ ╦══╗ ╦══╗');
  76.   WRITELN('╠══╝ ║ ║ ║ ║ ║ ║ ║ ╠═╣ ║    ║   ╠═     ╚══╗ ║  ║ ╠═     ║   ║ ║ ║ ╠═╣ ╠═╦╝ ╠═  ');
  77.   WRITELN('╩    ╩ ╝ ╚═╝ ╝ ╚═╝ ╩ ╩ ╚══╝ ╩═╝ ╩══╝   ╚══╝ ╚══╝ ╩      ╩   ╚═╩═╝ ╩ ╩ ╩ ╚╝ ╩══╝');
  78.   WRITELN('Post Office Box 386,  Town of Mount Royal,  Montreal, Quebec,  Canada,  H3P 3C6');
  79.   TextInverseOff;
  80.   WRITELN('▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓▒▒░░▒▒▓▓██▓▓');
  81.   WRITELN; WRITELN;
  82.   TextInverseOn;
  83.   CeLn('               ');
  84.   CeLn('  FILE WEEDER  ');
  85.   CeLn('  Version 2.0  ');
  86.   CeLn('               ');
  87.   TEXTCOLOR(LIGHTGRAY); TEXTBACKGROUND(BLACK);
  88.   WINDOW(1,15,80,25);
  89. END; { Procedure PINNACLE }
  90.  
  91. PROCEDURE OpenFiles;
  92. VAR
  93.   InOkay   : BOOLEAN;
  94.   OutOkay  : BOOLEAN;
  95. BEGIN
  96.   InOkay  := FALSE;
  97.   OutOkay := FALSE;
  98.   REPEAT
  99.     Pinnacle;
  100.     CeLn('─── ESC to Quit ───');
  101.     WRITELN;
  102.     CeLn('Press  D  to  delete  lines containing specified text');
  103.     WRITELN;
  104.     CeLn('Press  C  to   copy   lines containing specified text');
  105.     WRITELN;
  106.     WRITELN;
  107.     Ce('');
  108.     Method := UPCASE(READKEY);
  109.   UNTIL Method IN [#27, 'D', 'C'];
  110.   CLRSCR;
  111.   IF Method = #27 THEN HALT;
  112.   REPEAT
  113.     WRITELN;
  114.     CeLn('─── ESC to Quit ───');
  115.     WRITELN;
  116.     CeLn('Press  Y  if the text must match exactly (i.e. "CAT" doesn''t match "cat")');
  117.     WRITELN;
  118.     CeLn('Press  N  if the text doesn''t have to match exactly  (i.e. "CAT" = "cat")');
  119.     WRITELN;
  120.     WRITELN;
  121.     Ce('');
  122.     Casing := UPCASE(READKEY);
  123.   UNTIL Casing IN [#27, 'Y', 'N'];
  124.   CLRSCR;
  125.   IF Casing = #27 THEN HALT;
  126.   WRITELN; WRITELN;
  127.   {$I-}
  128.   REPEAT
  129.     WRITELN;
  130.     WRITE('Enter the  Input  file name ..... ');
  131.     READLN(InFileName);
  132.     IF LENGTH(InFileName) = 0
  133.     THEN Finished := TRUE
  134.     ELSE
  135.     BEGIN
  136.       InFileName := Upper(InFileName);
  137.       ASSIGN(InFile,InFileName);
  138.       RESET(InFile);
  139.       IF IOresult = 0
  140.       THEN InOkay := TRUE
  141.       ELSE
  142.       BEGIN
  143.         WRITELN;
  144.         WRITELN(InFileName,' can not be found.');
  145.       END;
  146.     END;
  147.   UNTIL InOkay OR Finished;
  148.   IF InOkay AND (NOT Finished) THEN
  149.   REPEAT
  150.     WRITELN;
  151.     WRITE('Enter the  Output file name ..... ');
  152.     READLN(OutFileName);
  153.     IF LENGTH(OutFileName) = 0
  154.     THEN Finished := TRUE
  155.     ELSE
  156.     BEGIN
  157.       OutFileName := Upper(OutFileName);
  158.       ASSIGN(OutFile,OutFileName);
  159.       RESET(OutFile);
  160.       IF IOresult > 0
  161.       THEN
  162.       BEGIN
  163.         REWRITE(OutFile);
  164.         OutOkay := TRUE;
  165.       END
  166.       ELSE
  167.       BEGIN
  168.         WRITELN;
  169.         WRITE(OutFileName,' already exists.  Use it?  (Press Y or N)  ');
  170.         InChar := READKEY;
  171.         InChar := UPCASE(InChar);
  172.         IF InChar = 'Y' THEN
  173.         BEGIN
  174.           OutOkay := TRUE;
  175.           REWRITE(OutFile);
  176.         END;
  177.       END;
  178.     END;
  179.   UNTIL OutOkay OR Finished;
  180.   {$I+}
  181. END;
  182.  
  183. PROCEDURE GetDelText;
  184. BEGIN
  185.   CLRSCR;
  186.   WRITELN('You can specify up to ',MaxDelText,' bits of text.');
  187.   WRITE  ('Lines containing that ');
  188.   IF Casing = 'Y' THEN WRITE('precise ');
  189.   WRITE('text will be ');
  190.   IF Method = 'C'
  191.   THEN WRITELN('copied.')
  192.   ELSE WRITELN('deleted.');
  193.   WRITELN;
  194.   WRITELN('Enter an empty line to start processing.');
  195.   WRITELN;
  196.   DelCount := 0;
  197.   REPEAT
  198.     DelCount := DelCount + 1;
  199.     WRITE('#',DelCount,' >  ');
  200.     READLN(DelText[DelCount]);
  201.     IF Casing = 'N' THEN DelText[DelCount] := Upper(DelText[DelCount]);
  202.   UNTIL (DelCount = MaxDelText) OR (DelText[DelCount] = '');
  203.   IF DelText[DelCount] = '' THEN DelCount := DelCount - 1;
  204.   CLRSCR;
  205.   IF DelCount = 0 THEN HALT;
  206. END;
  207.  
  208. PROCEDURE WeedOut;
  209. VAR
  210.   Counter  : INTEGER;
  211.   DelTally : INTEGER;
  212.   DTCntr   : INTEGER;
  213.   FoundIt  : BOOLEAN;
  214. BEGIN
  215.   Counter := 0;
  216.   DelTally := 0;
  217.   WINDOW(1,1,80,25);
  218.   TEXTCOLOR(WHITE); TEXTBACKGROUND(BLACK);
  219.   GOTOXY(1,1);
  220.   CLRSCR;
  221.   WRITE('Press the spacebar to abort ');
  222.   IF Method = 'D'
  223.   THEN WRITELN('weeding.')
  224.   ELSE WRITELN('copying.');
  225.   WRITELN;
  226.   REPEAT
  227.     READLN(InFile,InData);
  228.     IF Casing = 'N'
  229.     THEN CompData := Upper(InData)
  230.     ELSE CompData := InData;
  231.     Counter := Counter + 1;
  232.     IF Counter DIV 100 * 100 = Counter THEN WRITE(' ',Counter,' lines',^M);
  233.     DTCntr := 0;
  234.     FoundIt := FALSE;
  235.     REPEAT
  236.       DTCntr := DTCntr + 1;
  237.       IF POS(DelText[DTCntr],CompData) > 0 THEN FoundIt := TRUE;
  238.     UNTIL FoundIt OR (DTCntr = DelCount);
  239.     IF Method = 'D' THEN
  240.     BEGIN
  241.       IF FoundIt
  242.       THEN DelTally := DelTally + 1
  243.       ELSE WRITELN(OutFile,InData);
  244.     END
  245.     ELSE
  246.     BEGIN
  247.       IF FoundIt
  248.       THEN
  249.       BEGIN
  250.         WRITELN(OutFile,InData);
  251.         DelTally := DelTally + 1;
  252.       END;
  253.     END;
  254.     IF KEYPRESSED THEN
  255.     BEGIN
  256.       WRITELN; WRITELN;
  257.       WRITE('Stop?  (Press Y or N)  ');
  258.       InChar := UPCASE(READKEY);
  259.       WRITELN; WRITELN;
  260.       IF InChar = 'Y' THEN Finished := TRUE;
  261.     END;
  262.   UNTIL EOF(InFile) OR Finished;
  263.   CLRSCR;
  264.   WRITELN;
  265.   WRITELN;
  266.   WRITELN;
  267.   WRITE(Counter,' lines read.  ',DelTally,' lines ');
  268.   IF Method = 'D'
  269.   THEN WRITELN('deleted.')
  270.   ELSE WRITELN('copied.');
  271. END;
  272.  
  273. PROCEDURE CloseFiles;
  274. BEGIN
  275.   CLOSE(InFile);
  276.   CLOSE(OutFile);
  277. END;
  278.  
  279. BEGIN
  280.   StartUp;
  281.   OpenFiles;
  282.   IF NOT Finished THEN
  283.   BEGIN
  284.     GetDelText;
  285.     WeedOut;
  286.     CloseFiles;
  287.   END;
  288. END.
  289.